home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Fritz: All Fritz
/
All Fritz.zip
/
All Fritz
/
FILES
/
PROGSCAL
/
TBUTIL1.LZH
/
QISORT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1984-07-13
|
4KB
|
129 lines
PROGRAM qsort(INPUT,OUTPUT);
CONST max = 2000; {max array size}
TYPE standardarray = ARRAY[0..max] OF INTEGER;
VAR numbers: standardarray; {numeric array}
last: INTEGER;
PROCEDURE SWAP( VAR a,b: INTEGER );
VAR t: INTEGER;
BEGIN
t := a;
a := b;
b := t
END;
PROCEDURE getarray( VAR top : INTEGER ); {fill array from input}
VAR index, maxnum: INTEGER;
temp: INTEGER;
BEGIN {getarray}
index := 0;
RANDOMIZE;
WRITE(' Number of integers: ');
READ(maxnum);
IF maxnum > max THEN maxnum := max;
WHILE index <= maxnum DO
BEGIN
temp := RANDOM( index+1 );
numbers[index] := temp;
index := SUCC(index);
END;
WRITELN;
WRITELN( index-1:4, ' VALUES ENTERED' );
top := index - 2
END; {getarray}
PROCEDURE printarray( top: INTEGER ); {output array}
VAR index: INTEGER;
BEGIN {printarray}
FOR index := 0 TO top DO
BEGIN
IF index/4 = TRUNC(index/4) THEN WRITELN;
WRITE( numbers[index]:8 );
END
END; {printarray}
PROCEDURE bsort( start, top: INTEGER; VAR arry: standardarray );
{bubble sort procedure. sorts array from start to top inclusive}
VAR index: INTEGER;
switched: BOOLEAN;
BEGIN {bsort}
repeat
switched := FALSE;
FOR index := start TO top-1 DO
BEGIN
IF arry[index] > arry[index+1] THEN
BEGIN
SWAP( arry[index], arry[index+1] );
switched := TRUE;
END
END;
UNTIL switched = FALSE;
END; {bsort}
PROCEDURE findmedian( start, top: INTEGER; VAR arry: standardarray );
{procedure to find a good median value in array and place it}
VAR middle: INTEGER;
sorted: standardarray;
BEGIN {findmedian}
middle := (start + top) DIV 2;
sorted[1] := arry[start];
sorted[2] := arry[top];
sorted[3] := arry[middle];
bsort( 1, 3, sorted );
IF sorted[2] = arry[middle] THEN
SWAP( arry[start], arry[middle] )
ELSE IF sorted[2] = arry[top] THEN
SWAP( arry[start], arry[top] );
END; {findmedian}
PROCEDURE sortsection( start, top: INTEGER; VAR arry: standardarray );
{procedure to sort a section of the main array, and }
{then divide it into two partitions to be sorted }
VAR swapup: BOOLEAN;
s,e,m: INTEGER;
BEGIN {sortsection}
IF top - start < 6 THEN {sort small sections with bsort}
bsort( start, top, arry )
ELSE
BEGIN
findmedian( start, top, arry );
swapup := TRUE;
{start scanning from array top}
s := start; {lower comparison limit}
e := top; {upper comparison limit}
m := start; {location of comparison value}
WHILE e > s DO
BEGIN
IF swapup = TRUE THEN
{scan downward from partition top}
{and exchange if smaller than median}
BEGIN
WHILE( arry[e] >= arry[m] ) AND (e > m) DO
e := e - 1;
IF e > m THEN
BEGIN
SWAP( arry[e], arry[m] );
m := e;
END;
swapup := FALSE;
END
ELSE
{scan upward from a partition start}
{and exchange if larger than median}
BEGIN
WHILE( arry[s] <= arry[m] ) AND (s < m) DO
s := s + 1;
IF s < m THEN
BEGIN
SWAP( arry[s], arry[m] );
m := s;
END;
swapup := TRUE;
END
END;
sortsection( start, m-1, arry ); {sort lower half of partition}
sortsection( m+1, top, arry ); {sort upper half of partition}
END
END; {sortsection}
BEGIN {qsort - main program}
getarray(last);
sortsection( 0, last, numbers );
printarray(last);
END. {qsort}